' 
' This script will  convert the WebApplication.tpl file into an usable Windows 
' Installer XML file by adding files and folders found in \Sources with the adequate 
' access rights (network service, internet guest account) and the  components for 
' one feature
'


' Define variables
  Dim oFileSystem, sPath, sComponents, oReadFile, oWriteFile, bLoop, sLine, iArrayCount
  Dim aSpecialFolders()

' Start output
  Wscript.Echo "Starting... This script may take a wile..."

' Defaults
  sPath = Replace(WScript.ScriptFullName, "\" & WScript.ScriptName,"")
  sSourcePrefix = "Sources"
  sOutputFile = InputBox("Please specify a filename for the configuration output:","Configfile name","MyWebApplication", 100, 100) & ".wxs"

' Ask for folders which need full access rights
  iArrayCount = 0
  Do
	  sTMP = InputBox("Please specify the folders the IIS (Network Service User) should be granted write access for. Name these folders relative to Sources (E.g.: ...Sources\App_Data -> App_Data). End this dialog with leaving the input field empty.","Write permissions","", 100, 100)
	  If sTMP <> "" Then
		  ReDim preserve aSpecialFolders((iArrayCount + 1))
		  aSpecialFolders(iArrayCount) = sTMP
		  iArrayCount = iArrayCount + 1
	  End If
  Loop While sTMP <> ""
  ReDim preserve aSpecialFolders((iArrayCount + 1))


  ' Creating Filesystem object
  Set oFileSystem = CreateObject("Scripting.FileSystemObject")

  ' Open template
  Set oReadFile = oFileSystem.OpenTextFile(sPath & "\WebApplication.tpl", 1) 'Reading
  
  ' Open target file
  Set oWriteFile = oFileSystem.OpenTextFile(sPath & "\" & sOutputFile, 2, true) 'Writing

  ' Start copying template rows
  Wscript.Echo "Copy template rows..."
  
  bLoop = False
  Do Until oReadFile.AtEndOfStream
	  sLine = oReadFile.Readline
	 
	If Not bLoop Then
   	  oWriteFile.WriteLine(sLine)
    End If 
	 
    If InStr(1, sLine, "@@FILESSTART@@") > 0Then
   	  bLoop = True
   	  Wscript.Echo "Creating file and folder definitions"
   	  Call processFolder(sPath & "\" & sSourcePrefix, 0, False)
    End If
   
    If InStr(1, sLine, "@@COMPONENTSSTART@@") > 0Then
   	  bLoop = True
   	  Wscript.Echo "Creating component references"
   	  oWriteFile.Write(sComponents& vbCrLf)
    End If
   
    If (InStr(1, sLine, "@@FILESEND@@") > 0) Or (InStr(1, sLine, "@@COMPONENTSEND@@") > 0) Then
   	  Wscript.Echo "Copy template rows..."
   	  oWriteFile.WriteLine(sLine)
   	  bLoop = False
    End If
  Loop

' Close files and finish
  oReadFile.Close
  oWriteFile.Close

Wscript.Echo "Finished!"

Sub processFolder(sFolder, iDepth, bMyWriteAble)
    Dim oFiles, oFolder, oSubfolders, oSubfolder, sRelativePath, sIdent, iCount, sIdentFile, aElements, sIdentDirectory
    Dim sIdentComponent, oFile, sSpace, bWriteAble, sEnding
    
    ' Set bWriteAble (if this folder / files can be altered by network service)
    bWriteAble = bMyWriteAble
    
    ' Create spaces for nice xml output
    sSpace = Space((iDepth * 2))
    
    ' Get objects
    Set oFolder = oFileSystem.GetFolder(sFolder)
	Set oFiles = oFolder.Files
    Set oSubfolders = oFolder.SubFolders
	  
	' Create relative path
	sRelativePath = Replace(sFolder, sPath & "\" & sSourcePrefix, "")

    ' Check if the current directory should be writeable
    If Not bWriteAble Then
      If sRelativePath <> "" Then
		For iCount = LBound(aSpecialFolders) To UBound(aSpecialFolders)
			If (aSpecialFolders(iCount) = sRelativePath) Or (aSpecialFolders(iCount) = Right(sRelativePath, (Len(sRelativePath) - 1 ) ) )  Then
				bWriteAble = True
			End If
        Next
      End If
    End If

    ' Create camel nose ident part for folders
    sIdent = Replace(sRelativePath, "-", "_")
    sIdent = Replace(sIdent, " ", "_")
	  
	' If sIdent is empty it is the root directory - this is already configured in the template file
	If sIdent = "" Then
		sIdent = "RootDir"
		sIdentDirectory = "TARGETDIR"
	Else
		aElements = split(sIdent, "\")
		sIdent = ""
		For iCount = LBound(aElements) To UBound(aElements)
			If aElements(iCount) <> "" Then
				sIdent = sIdent & UCase(Left(aElements(iCount),1)) & Right(aElements(iCount), (Len(aElements(iCount)) - 1) )    
			End If
		Next
	End If
	  
	' Write Direcotry header / start
	If iDepth > 0 Then
		sIdentDirectory = sIdent & "Directory"
	  	
	  	' Verify that ident is < 72 chars
	    If Len(sIdentDirectory) > 72 Then sIdentDirectory = Right(sIdentDirectory, 72)
	  	
	  	oWriteFile.WriteLine(sSpace & "<Directory Id=" & Chr(34) & sIdentDirectory & Chr(34) &  " Name="  & Chr(34) & oFolder.Name  & Chr(34) &  ">")
	End If
	  
	' Write Component header / start
	sIdentComponent = sIdent & "Component"	
	If Len(sIdentComponent) > 72 Then sIdentComponent = Right(sIdentComponent, 72)
	oWriteFile.WriteLine(sSpace & Space(2) & "<Component Id=" & Chr(34) & sIdentComponent & Chr(34) &  " DiskId=" & Chr(34) & "1" & Chr(34) & " Guid=" & Chr(34) & getGUID() & Chr(34) & ">")
    
    ' Add Feature component ref
    sComponents = sComponents & vbCrLf & Space(6) & "<ComponentRef Id=" & Chr(34) &  sIdentComponent & Chr(34) &  " />"
    
	' Process Files
	'detect any number character within the file as WIX doesn't like it 
	'replace it with an underscore
	Set regEx = New RegExp				' Create regular expression.
	regEx.Global = True					'to continue after first match
	regEx.Pattern = "^[^A-Za-z_]{1}|[^A-Za-z0-9_.]"		' Identifiers may contain ASCII characters A-Z, a-z, digits, underscores (_), or periods (.).  Every identifier must begin with either a letter or an underscore.
	regEx.IgnoreCase = True            ' Make case insensitive.

	Randomize	
    For Each oFile In oFiles
		randomstring = ""
		for randomcharscount = 0 to 2
			randomstring = randomstring & chr((rnd()*9)+48) ' add a random number 0-9
		next
		
		sIdentFile = sIdent & oFile.Name & randomstring 			'attach some random chars to avoid duplicate fileIDs
		sIdentFile = Replace(sIdentFile, "-", "_")
		sIdentFile = Replace(sIdentFile, " ", "_")

		'cut name if too long
		If Len(sIdentFile) > 72 Then sIdentFile = Right(sIdentFile, 72)
		
		'do regex search
		Set Matches = regEx.Execute(sIdentFile)	' Execute search.
		For Each Match in Matches  				' Iterate Matches collection.
			randomchar = chr((rnd()*25)+97)		' a random char between a-z
			sIdentFile = Replace(sIdentFile,Match.Value,randomchar)
		Next
		Set Matches = nothing
		
		oWriteFile.WriteLine(sSpace & Space(4) & "<File Id=" & Chr(34) & sIdentFile & Chr(34) & " Name="  & Chr(34) & oFile.Name  & Chr(34) &  " Source="  & Chr(34) & sSourcePrefix & sRelativePath & "\" & oFile.Name  & Chr(34) & ">")
      
		' Add file permissions
		addPermissions sSpace & Space(4), bWriteAble, False
		oWriteFile.WriteLine(sSpace & Space(4) & "</File>")
	Next
    
	' Add folder permissions if necessary
	oWriteFile.WriteLine(sSpace & Space(4) & "<CreateFolder Directory="  & Chr(34) & sIdentDirectory  & Chr(34) &  ">")
	addPermissions sSpace & Space(4), bWriteAble, True
	oWriteFile.WriteLine(sSpace & Space(4) & "</CreateFolder>")
     
	' Add component footer / end
	oWriteFile.WriteLine(sSpace & Space(2) & "</Component>")
	  
	' Loop trough folders
    For Each oSubfolder In oSubfolders
      Call processFolder(sFolder & "\" & oSubfolder.Name, (iDepth + 1), bWriteAble)
    Next
    
    ' Write Direcotry footer / end
    If iDepth > 0 Then
	  	oWriteFile.WriteLine(sSpace & "</Directory>")
	  End If
End Sub

Function addPermissions (sSpace, bWriteAble, bIsFolder) 
	' Array structure 1..n arrays of: 
	'Array(bool UsePermissionEx, bool NeedWriteAccess, bool isFolder,  string UserName, string DomainName, 1..n Permission)
   Dim aACL(3) ' With administrator / local system it would be 12 but its unneccessary to set them - they are there
   Dim iACLCount, iElementCount, aMagic(0), aTMP
   
   ' Network Service, writeable, directory 
   aACL(0) = Array(True, True, True,  "NetworkService", "", "GenericAll")
   
   ' Network Service, not write able,
   aACL(1) = Array(True, False, True,  "NetworkService", "", "GenericRead", "Read", "ReadAttributes", "Traverse")

   ' Internet guest account, always set (writeable / not writeable), directory
   aACL(2) = Array(True, True,  True,  "[INTERNETGUESTACCOUNT]", "[INTERNETGUESTDOMAIN]", "GenericAll")
   aACL(3) = Array(True, False, True,  "[INTERNETGUESTACCOUNT]", "[INTERNETGUESTDOMAIN]", "GenericRead", "Read", "ReadAttributes", "Traverse")
   
'don't set acls on each file let inheritance of folder permissions take over
  'aACL(1) = Array(True, True, False, "NetworkService", "", "GenericAll")
  'aACL(3) = Array(True, False, False, "NetworkService", "", "GenericRead", "Read", "ReadAttributes", "GenericExecute", "Execute")
  'aACL(5) = Array(True, True,  False, "[INTERNETGUESTACCOUNT]", "[INTERNETGUESTDOMAIN]", "GenericRead", "Read", "ReadAttributes", "GenericExecute", "Execute")
  'aACL(7) = Array(True, False, False, "[INTERNETGUESTACCOUNT]", "[INTERNETGUESTDOMAIN]", "GenericRead", "Read", "ReadAttributes", "GenericExecute", "Execute")
  
   ' Process entries
	For iACLCount = LBound(aACL) To UBound(aACL)
		aMagic(0) = aACL(iACLCount)
		aTMP = aMagic(0)
		If aTMP(1) = bWriteAble And aTMP(2) = bIsFolder Then
			oWriteFile.Write(sSpace & Space(2))
			'determines which WIX Extension is used to set the permissions
			If aTMP(0) Then
				oWriteFile.Write("<util:PermissionEx User=" & chr(34) & aTMP(3) & Chr(34) & " ")
			Else
				oWriteFile.Write("<Permission User=" & chr(34) & aTMP(3) & Chr(34) & " ")
			End If
			'determines if a domain name needs to be added to the username
			If aTMP(4) <> "" Then
				oWriteFile.Write("Domain=" & chr(34) & aTMP(4) & Chr(34) & " ")
			End If
			'writes all of the 1..n Permissions as set in the above array    	 
			For iElementCount = 5 To UBound(aTMP)
				oWriteFile.Write(aTMP(iElementCount) & "=" & chr(34) & "yes" & Chr(34) & " ")
			Next
			oWriteFile.WriteLine("/>")
		End If
	Next
   
End Function

Function getGUID()
  ' Every component has to have an unique identifier in form of a 8-4-4-4-12 string...
  getGUID = guidPart(8) & "-" & guidPart(4) & "-" & guidPart(4) & "-" & guidPart(4) & "-" & guidPart(12)
End Function

Function guidPart(iLength)
  Dim aChars(16), sPart

  ' This function creates sub elements of iLength len for the unique identifier

     aChars(0) = "A"
     aChars(1) = "B"
     aChars(2) = "C"
     aChars(3) = "D"
     aChars(4) = "E"
     aChars(5) = "F"
     aChars(6) = "0"
     aChars(7) = "1"
     aChars(8) = "2"
     aChars(9) = "3"
     aChars(10) = "4"
     aChars(11) = "5"
     aChars(13) = "6"
     aChars(14) = "8"
     aChars(15) = "9"

     sPart = ""
     Randomize
     Do Until Len(sPart) = Int(iLength)
           sPart = sPart & aChars(int(rnd()*15))
     Loop
     
  guidPart = sPart
End Function